home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / JOYSTICK.SWG / 0011_Accessing The Joystick.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-25  |  2KB  |  93 lines
  1. {by Sean Palmer}
  2. {public domain}
  3. {feel free to put this in SWAG or whatever}
  4.  
  5. unit joy;
  6.  
  7. {unit for accessing joystick 0}
  8.  
  9. interface
  10.  
  11. var
  12.  installed:boolean; {true if joystick 0 present at unit startup}
  13. var
  14.  X,Y:word;          {stick position}
  15. var
  16.  A,B:boolean;       {buttons down?}
  17. const
  18.  Cal_L:word=$FFFF;   {rect containing calibration extent of 'center'}
  19.  Cal_T:word=$FFFF;
  20.  Cal_R:word=0;
  21.  Cal_B:word=0;
  22.  
  23. procedure sample;   {take a sample of current joystick 0 state}
  24. procedure swirlCalibrate;
  25. procedure centerCalibrate;
  26.  
  27.  
  28. implementation
  29.  
  30. procedure sample;assembler;asm
  31.  xor si,si     {x count}
  32.  xor di,di     {y count}
  33.  mov dx,$201   {Game port}
  34.  out dx,al     {Fire the joystick one-shots}
  35. @@L:
  36.  in  al,dx     {get joystick bits}
  37.  mov ah,al     {save original value}
  38.  shr al,1      {joy 0 x expired? 0 if so, else 1}
  39.  adc si,0      {accumulate in x}
  40.  jc @@TOOLONG  {if overflow, give up}
  41.  shr al,1      {joy 0 y expired? 0 if so, else 1}
  42.  adc di,0      {accumulate in y}
  43.  jc @@TOOLONG  {if overflow, give up}
  44.  test ah,3
  45.  jnz @@L       {keep going til they're both 0 or we overflow}
  46.  not ah        {flip button bits so 1=pressed}
  47.  mov al,ah
  48.  and al,$10    {mask off buttons and store them}
  49.  mov A,al
  50.  and ah,$20
  51.  mov B,ah
  52.  mov X,si      {store x & y coords}
  53.  mov Y,di
  54.  jmp @@X
  55. @@TOOLONG:
  56.  mov X,-1      {overflowed, return -1 as error}
  57.  mov Y,-1
  58.  mov A,0
  59.  mov B,0
  60. @@X:
  61. end;
  62.  
  63. procedure swirlCalibrate;begin  {display message before starting this one!}
  64.  repeat sample until not (A or B);{make sure button is up}
  65.  repeat                           {collect max extents}
  66.   sample;
  67.   if x<Cal_L then Cal_L:=x;
  68.   if x>Cal_R then Cal_R:=x;
  69.   if y<Cal_T then Cal_T:=y;
  70.   if y>Cal_B then Cal_B:=y;
  71.   until a;                        {until user presses a button}
  72.   Cal_L:=((Cal_L*3)+Cal_R)div 4;      {now adjust for center by}
  73.   Cal_R:=((Cal_R*3)+Cal_L)div 4;      { weighted averaging}
  74.   Cal_T:=((Cal_T*3)+Cal_B)div 4;
  75.   Cal_B:=((Cal_B*3)+Cal_T)div 4;
  76.  end;
  77.  
  78. procedure centerCalibrate;var x2,y2:word;begin {doesn't require user
  79. interaction}
  80.  sample;
  81.  x2:=x shr 1;
  82.  y2:=y shr 1;
  83.  Cal_L:=x-x2;
  84.  Cal_R:=x+x2;
  85.  Cal_T:=y-y2;
  86.  Cal_B:=y+y2;
  87.  end;
  88.  
  89. begin
  90.  sample;
  91.  installed:=(x<>$FFFF);
  92. end.
  93.